home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / SCHEME / GNU / SCM4E1 / !Scm / slib / strport < prev    next >
Text File  |  1993-04-02  |  1KB  |  36 lines
  1. ;;;;"strport.scm" Portable string ports for Scheme
  2. ;;;Copyright 1993 Dorai Sitaram and Aubrey Jaffer.
  3.  
  4. ;N.B.: This implementation assumes you have tmpnam and
  5. ;delete-file defined in your .init file.  tmpnam generates
  6. ;temp file names.  delete-file may be defined to be a dummy
  7. ;procedure that does nothing.
  8.  
  9. (define (call-with-output-string f)
  10.   (let ((tmpf (tmpnam)))
  11.     (call-with-output-file tmpf f)
  12.     (let ((s "") (buf (make-string 512)))
  13.       (call-with-input-file tmpf
  14.     (lambda (inp)
  15.       (let loop ((i 0))
  16.         (let ((c (read-char inp)))
  17.           (cond ((eof-object? c)
  18.              (set! s (string-append s (substring buf 0 i))))
  19.             ((>= i 512)
  20.              (set! s (string-append s buf))
  21.              (loop 0))
  22.             (else
  23.              (string-set! buf i c)
  24.              (loop (+ i 1))))))))
  25.       (delete-file tmpf)
  26.       s)))
  27.  
  28. (define (call-with-input-string s f)
  29.   (let ((tmpf (tmpnam)))
  30.     (call-with-output-file tmpf
  31.       (lambda (outp)
  32.     (display s outp)))
  33.     (let ((x (call-with-input-file tmpf f)))
  34.       (delete-file tmpf)
  35.       x)))
  36.